home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr25 / isp3009b.zip / ISPELL.EL < prev    next >
Lisp/Scheme  |  1993-03-04  |  39KB  |  953 lines
  1. ;;; Spelling correction interface for GNU EMACS "ispell"
  2. ;;; $Id: ispell.el,v 2.19 1992/01/10 10:54:08 geoff Exp $
  3. ;;;
  4. ;;; $Log: ispell.el,v $
  5. ;;; Revision 2.19  1992/01/10  10:54:08  geoff
  6. ;;; Make another attempt at fixing the "Bogus, dude" problem.  This one is
  7. ;;; less elegant, but has the advantage of working.
  8. ;;;
  9. ;;; Revision 2.18  1992/01/07  10:04:52  geoff
  10. ;;; Fix the "Bogus, Dude" problem in ispell-word.
  11. ;;;
  12. ;;; Revision 2.17  91/09/12  00:01:42  geoff
  13. ;;; Add some changes to make ispell-complete-word work better, though
  14. ;;; still not perfectly.
  15. ;;; 
  16. ;;; Revision 2.16  91/09/04  18:00:52  geoff
  17. ;;; More updates from Sebastian, to make the multiple-dictionary support
  18. ;;; more flexible.
  19. ;;; 
  20. ;;; Revision 2.15  91/09/04  17:30:02  geoff
  21. ;;; Sebastian Kremer's tib support
  22. ;;; 
  23. ;;; Revision 2.14  91/09/04  16:19:37  geoff
  24. ;;; Don't do set-window-start if the move-to-window-line moved us
  25. ;;; downward, rather than upward.  This prevents getting the buffer all
  26. ;;; confused.  Also, don't use the "not-modified" function to clear the
  27. ;;; modification flag;  instead use set-buffer-modified-p.  This prevents
  28. ;;; extra messages from flashing.
  29. ;;; 
  30. ;;; Revision 2.13  91/09/04  14:35:41  geoff
  31. ;;; Fix a spelling error in a comment.  Add code to handshake with the
  32. ;;; ispell process before sending anything to it.
  33. ;;; 
  34. ;;; Revision 2.12  91/09/03  20:14:21  geoff
  35. ;;; Add Sebastian Kremer's multiple-language support.
  36. ;;; 
  37.  
  38. ;;; Walt Buehring
  39. ;;; Texas Instruments - Computer Science Center
  40. ;;; ARPA:  Buehring%TI-CSL@CSNet-Relay
  41. ;;; UUCP:  {smu, texsun, im4u, rice} ! ti-csl ! buehring
  42.  
  43. ;;; ispell-region and associated routines added by
  44. ;;; Perry Smith
  45. ;;; pedz@bobkat
  46. ;;; Tue Jan 13 20:18:02 CST 1987
  47.  
  48. ;;; extensively modified by Mark Davies and Andrew Vignaux
  49. ;;; {mark,andrew}@vuwcomp
  50. ;;; Sun May 10 11:45:04 NZST 1987
  51.  
  52. ;;; This file has overgone a major overhaul to be compatible with ispell
  53. ;;; version 2.1.  Most of the functions have been totally rewritten, and
  54. ;;; many user-accessible variables have been added.  The syntax table has
  55. ;;; been removed since it didn't work properly anyway, and a filter is
  56. ;;; used rather than a buffer.  Regular expressions are used based on
  57. ;;; ispell's internal definition of characters (see ispell(4)).
  58. ;;; Ken Stevens     ARPA: stevens@hplabs.hp.com    UUCP: hplabs!stevens
  59. ;;; Tue Jan  3 16:59:07 PST 1989
  60. ;;; Some new updates:
  61. ;;; - Updated to version 3.0 to include terse processing.
  62. ;;; - Added a variable for the look command.
  63. ;;; - Fixed a bug in ispell-word when cursor is far away from the word
  64. ;;;   that is to be checked.
  65. ;;; - Ispell places the incorrect word or guess in the minibuffer now.
  66. ;;; - fixed a bug with 'l' option when multiple windows are on the screen.
  67. ;;; - lookup-words just didn't work with the process filter.  Fixed.
  68. ;;; - Rewrote the process filter to make it cleaner and more robust
  69. ;;;   in the event of a continued line not being completed.
  70. ;;; - Made ispell-init-process more robust in handling errors.
  71. ;;; - Fixed bug in continuation location after a region has been modified by
  72. ;;;   correcting a misspelling.
  73. ;;; Mon 17 Sept 1990
  74.  
  75. ;;; Sebastian Kremer <sk@thp.uni-koeln.de>
  76. ;;; Wed Aug  7 14:02:17 MET DST 1991
  77. ;;; - Ported ispell-complete-word from Ispell 2 to Ispell 3.
  78. ;;; - Added ispell-kill-ispell command.
  79. ;;; - Added ispell:dictionary and ispell:dictionary-alist variables to
  80. ;;;   support other than default language.  See their docstrings and
  81. ;;;   command ispell-change-dictionary.
  82. ;;; - (ispelled it :-)
  83. ;;; - Added ispell:check-tib variable to support the tib bibliography
  84. ;;;   program.
  85.  
  86. ;;; To fully install this, add this file to your GNU lisp directory and 
  87. ;;; compile it with M-X byte-compile-file.  Then add the following to the
  88. ;;; appropriate init file:
  89.  
  90. ;;;  (autoload 'ispell-word "ispell"
  91. ;;;    "Check the spelling of word in buffer." t)
  92. ;;;  (global-set-key "\e$" 'ispell-word)
  93. ;;;  (autoload 'ispell-region "ispell"
  94. ;;;    "Check the spelling of region." t)
  95. ;;;  (autoload 'ispell-buffer "ispell"
  96. ;;;    "Check the spelling of buffer." t)
  97. ;;;  (autoload 'ispell-complete-word "ispell"
  98. ;;;    "Look up current word in dictionary and try to complete it." t)
  99. ;;;  (autoload 'ispell-change-dictionary "ispell"
  100. ;;;    "Change ispell dictionary." t)
  101.  
  102.  
  103. ;;; **********************************************************************
  104. ;;; The following variables should be set according to personal preference
  105. ;;; and location of binaries:
  106. ;;; **********************************************************************
  107.  
  108.  
  109. ;;;  ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.0
  110.  
  111.  
  112. ;;; Highlighting can slow down display at slow baud and emacs in
  113. ;;; X11 windows cannot take advantage of highlighting (yet).
  114. (defconst ispell:highlight-p t
  115.   "*When not nil, spelling errors will be highlighted.")
  116.  
  117. (defvar ispell:check-comments nil
  118.   "*When true, the spelling of comments in region is checked.")
  119.  
  120. (defvar ispell:check-tib nil
  121.   "*If non-nil, the spelling of references for the tib(1) bibliography
  122. program is checked.  Else any text between strings matching the regexps
  123. ispell:tib-ref-beginning and ispell:tib-ref-end is ignored, usually what
  124. you want.")
  125.  
  126. (defvar ispell:tib-ref-beginning "\\(\\[\\.\\)\\|\\(<\\.\\)"
  127.   "Regexp matching the beginning of a Tib reference.")
  128.  
  129. (defvar ispell:tib-ref-end "\\(\\.\\]\\)\\|\\(\\.\>\\)"
  130.   "Regexp matching the end of a Tib reference.")
  131.  
  132. (defvar ispell:keep-choices-win t
  133.   "*When true, the *Choices* window remains for spelling session.")
  134.  
  135. (defvar ispell:program-name "ispell"
  136.   "Program invoked by ispell-word and ispell-region commands.")
  137.  
  138. (defvar ispell:alternate-dictionary "/usr/dict/web2"
  139.   "Alternate dictionary for spelling help.")
  140.  
  141. (defvar ispell:grep-command "/usr/bin/egrep"
  142.   "Name of the grep command for search processes.")
  143.  
  144. (defvar ispell:look-command "/usr/bin/look"
  145.   "Name of the look command for search processes.")
  146.  
  147. (defvar ispell:dictionary nil
  148.   "If non-nil, a dictionary to use instead of the default one.
  149. This is passed to the ispell process using the \"-d\" switch and is
  150. used as key in ispell:dictionary-alist (which see).
  151.  
  152. You should set this variable before your first call to ispell (e.g. in
  153. your .emacs), or use the \\[ispell-change-dictionary] command to
  154. change it, as changing this variable only takes effect in a newly
  155. started ispell process.")
  156.  
  157. (defvar ispell:dictionary-alist        ; sk  9-Aug-1991 18:28
  158.   '((nil                ; default (english.aff) 
  159.      "[A-Za-z]" "[^A-Za-z]" "[---']" nil nil)
  160.     ("german"                ; german.aff
  161.      "[A-Za-z]" "[^A-Za-z]" "[---'\"]" t ("-C")) 
  162.     ;; add more dicts before this line
  163.     )
  164.   "An alist of dictionaries and their associated parameters.
  165.  
  166. Each element of this list is also a list:
  167.  
  168.     \(DICTIONARY-NAME
  169.         CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P
  170.         ISPELL-ARGS\)
  171.  
  172. DICTIONARY-NAME is a possible value of variable ispell:dictionary, nil
  173. means the default dictionary.
  174.  
  175. CASECHARS is a regular expression of valid characters that comprise a
  176. word.
  177.  
  178. NOT-CASECHARS is the opposite regexp of CASECHARS.
  179.  
  180. OTHERCHARS is a regular expression of other characters that are valid
  181. in word constructs.  Otherchars cannot be adjacent to each other in a
  182. word, nor can they begin or end a word.  This implies we can't check
  183. \"Stevens'\" as a correct possessive and other correct formations.
  184.  
  185. Hint: regexp syntax requires the hyphen to be declared first here.
  186.  
  187. MANY-OTHERCHARS-P is non-nil if many otherchars are to be allowed in a
  188. word instead of only one.
  189.  
  190. ISPELL-ARGS is a list of additional arguments passed to the ispell
  191. subprocess.
  192.  
  193. Note that the CASECHARS and OTHERCHARS slots of the alist should
  194. contain the same character set as casechars and otherchars in the
  195. language.aff file (e.g., english.aff).")
  196.  
  197. (defun ispell:get-casechars ()
  198.   (nth 1 (assoc ispell:dictionary ispell:dictionary-alist)))
  199. (defun ispell:get-not-casechars ()
  200.   (nth 2 (assoc ispell:dictionary ispell:dictionary-alist)))
  201. (defun ispell:get-otherchars ()
  202.   (nth 3 (assoc ispell:dictionary ispell:dictionary-alist)))
  203. (defun ispell:get-many-otherchars-p ()
  204.   (nth 4 (assoc ispell:dictionary ispell:dictionary-alist)))
  205. (defun ispell:get-ispell-args ()
  206.   (nth 5 (assoc ispell:dictionary ispell:dictionary-alist)))
  207.  
  208.  
  209. ;;; **********************************************************************
  210. ;;; The following are used by ispell, and should not be changed.
  211. ;;; **********************************************************************
  212.  
  213.  
  214. (defvar ispell-process nil
  215.   "Holds the process object for 'ispell'")
  216.  
  217. (defvar ispell:pdict-modified-p nil
  218.   "T when the personal dictionary has modifications that need to be written.")
  219.  
  220. (defvar ispell:quit nil
  221.   "Set to t when user want to abort ispell session.")
  222.  
  223. (defvar ispell:look-p t
  224.   "Use look. Automatically reset if look not available")
  225.  
  226. (defvar ispell:filter nil
  227.   "Output filter from piped calls to ispell.")
  228.  
  229. (defvar ispell:filter-continue nil
  230.   "Control variable for ispell filter function.")
  231.  
  232.  
  233.  
  234.  
  235. (defun ispell-word (&optional preceding quietly)
  236.   "Check spelling of word under or following the cursor.
  237. If word not found in dictionary, display possible corrections in a window 
  238. and let user select.
  239.   Optional argument PRECEDING set for checking preceding word when not
  240. over a word, and QUIETLY suppresses messages when word is correct.
  241.   Word syntax described by ispell:dictionary-alist (which see)."
  242.   (interactive)
  243.   (let* ((ispell-casechars (ispell:get-casechars))
  244.      (ispell-not-casechars (ispell:get-not-casechars))
  245.      (ispell-otherchars (ispell:get-otherchars))
  246.      (ispell-many-otherchars-p (ispell:get-many-otherchars-p))
  247.      (word-regexp (concat ispell-casechars
  248.                   "+\\("
  249.                   ispell-otherchars
  250.                   "?"
  251.                   ispell-casechars
  252.                   "+\\)"
  253.                   (if ispell-many-otherchars-p "*" "?")))
  254.      did-it-once
  255.      ispell:keep-choices-win    ; override global to force creation
  256.      start end word poss replace)
  257.     (save-excursion
  258.       ;; find the word
  259.       (if (not (looking-at ispell-casechars))
  260.       (if preceding
  261.           (re-search-backward ispell-casechars (point-min) t)
  262.         (re-search-forward ispell-casechars (point-max) t)))
  263.       ;; move to front of word
  264.       (re-search-backward ispell-not-casechars (point-min) 'start)
  265.       (while (and (looking-at ispell-otherchars)
  266.           (not (bobp))
  267.           (or (not did-it-once)
  268.               ispell-many-otherchars-p))
  269.     (progn
  270.       (setq did-it-once t)
  271.       (backward-char 1)
  272.       (if (looking-at ispell-casechars)
  273.           (re-search-backward ispell-not-casechars (point-min) t)
  274.         (backward-char -1))))
  275.       ;; Now mark the word and save to string.
  276.       (or (re-search-forward word-regexp (point-max) t)
  277.       (error "No word found to check!"))
  278.       (setq start (match-beginning 0)
  279.         end (match-end 0)
  280.         word (buffer-substring start end)))
  281.     (goto-char start)
  282.     ;; now check spelling of word.
  283.     (or quietly (message "Checking spelling of %s..." (upcase word)))
  284.     (ispell-init-process)        ; erases ispell output buffer
  285.     (process-send-string ispell-process "%\n") ;put in verbose mode
  286.     (process-send-string ispell-process (concat "^" word "\n"))
  287.     ;; wait until ispell has processed word
  288.     (while (progn
  289.          (accept-process-output ispell-process)
  290.          (not (string= "" (car ispell:filter)))))
  291.     (process-send-string ispell-process "!\n") ;back to terse mode.
  292.     (setq ispell:filter (cdr ispell:filter))
  293.     (if (listp ispell:filter)
  294.     (setq poss (ispell-parse-output (car ispell:filter))))
  295.     (cond ((eq poss t)
  296.        (or quietly (message "Found %s" (upcase word))))
  297.       ((stringp poss)
  298.        (or quietly (message "Found %s because of root %s" (upcase word) (upcase poss))))
  299.       ((null poss) (message "Error in ispell process"))
  300.       (t
  301.        (unwind-protect
  302.            (progn
  303.          (if ispell:highlight-p
  304.              (highlight-spelling-error start end t)) ; highlight word
  305.          (setq replace (ispell-choose (car (cdr (cdr poss)))
  306.                           (car (cdr (cdr (cdr poss))))
  307.                           (car poss)))
  308.          ;; update ispell:pdict-modified-p
  309.          (if (listp ispell:pdict-modified-p)
  310.              (setq ispell:pdict-modified-p
  311.                (car ispell:pdict-modified-p))))
  312.          ;; protected
  313.          (if ispell:highlight-p  ; clear highlight
  314.          (highlight-spelling-error start end)))
  315.        (cond (replace
  316.           (goto-char end)
  317.           (delete-region start end)
  318.           (if (atom replace)
  319.               (insert-string replace)
  320.             (insert-string (car replace)) ; replacement string, recheck spelling.
  321.             (ispell-word t quietly))))
  322.        (if (get-buffer "*Choices*")
  323.            (kill-buffer "*Choices*"))))
  324.     (ispell-pdict-save)
  325.     (if ispell:quit (setq ispell:quit nil))))
  326.  
  327.  
  328. (defun ispell-pdict-save ()
  329.   "Check to see if the personal dictionary has been modified.
  330.   If so, ask if it needs to be saved."
  331.   (interactive)
  332.   (if ispell:pdict-modified-p
  333.       (if (y-or-n-p "Personal dictionary modified.  Save? ")
  334.       (process-send-string ispell-process "#\n")))
  335.   (setq ispell:pdict-modified-p nil))        ; unassert variable, even if not saved to avoid questioning.
  336.  
  337.  
  338. ;;; Global ispell:pdict-modified-p is used to track changes in the dictionary.
  339. ;;;   The global becomes a list when we either accept or insert word into the dictionary.
  340. ;;;   The value of the only element in the list is the state of whether the dictionary
  341. ;;;   needs to be saved.
  342. (defun ispell-choose (miss guess word)
  343.   "Display possible corrections from list MISS.
  344.   GUESS lists possibly valid affix construction of WORD.
  345.   Returns nil to keep word.
  346.           string for new chosen word.
  347.           list for new replacement word (needs rechecking).
  348.   Global ispell:pdict-modified-p becomes a list where the only value indicates
  349.    whether the dictionary has been modified when option a or i is used.  This
  350.    must be returned to an atom by the calling program."
  351.   (unwind-protect
  352.       (save-window-excursion
  353.     (let ((count 0)
  354.           (line 2)
  355.           (choices miss)
  356.           (window-min-height 2)
  357.           char num result)
  358.       (save-excursion
  359.         (if ispell:keep-choices-win
  360.         (select-window (previous-window))
  361.           (set-buffer (get-buffer-create "*Choices*"))
  362.           (setq mode-line-format "--  %b  --"))
  363.         (if (equal (get-buffer "*Choices*") (current-buffer))
  364.         (erase-buffer)
  365.           (error "Bogus, dude!  I should be in the *Choices* buffer, but I'm not!"))
  366.         (if guess
  367.         (progn
  368.           (insert "\tAffix rules generate and capitalize this word as shown below:\n")
  369.           (while guess
  370.             (if (> (+ 4 (current-column) (length (car guess)))
  371.                (window-width))
  372.             (progn
  373.               (insert "\n")
  374.               (setq line (1+ line))))
  375.             (insert (car guess) "    ")
  376.             (setq guess (cdr guess)))
  377.           (insert "\nUse option \"i\" if this is a correct composition from the derivative root.\n\n")
  378.           (setq line (+ line 4))))
  379.         (while choices
  380.           (if (> (+ 7 (current-column) (length (car choices)))
  381.              (window-width))
  382.           (progn
  383.             (insert "\n")
  384.             (setq line (1+ line))))
  385.           ;; not so good if there are over 20 or 30 options, but then, if
  386.           ;; there are that many you don't want to have to scan them all anyway...
  387.           (insert "(" (+ count ?0) ") " (car choices) "  ")
  388.           (setq choices (cdr choices)
  389.             count (if (memq count '(14 48 56 59 64 71))    ; skip command characters.
  390.                   (if (= count 64)
  391.                   (+ count 3)
  392.                 (+ count 2))
  393.                 (1+ count)))))
  394.       (if ispell:keep-choices-win
  395.           (if (> line ispell:keep-choices-win)
  396.           (progn
  397.             (switch-to-buffer "*Choices*")
  398.             (select-window (next-window))
  399.             (save-excursion
  400.               (let ((cur-point (point)))
  401.             (move-to-window-line (- line ispell:keep-choices-win))
  402.             (if (<= (point) cur-point)
  403.                 (set-window-start (selected-window) (point)))))
  404.             (select-window (previous-window))
  405.             (enlarge-window (- line ispell:keep-choices-win))
  406.             (goto-char (point-min))))
  407.         (overlay-window line))
  408.       (switch-to-buffer "*Choices*")
  409.       (select-window (next-window))
  410.       (while (eq t
  411.              (setq result
  412.                (progn
  413.                  (message "^h or ? for more options; Space to leave unchanged, Character to replace word")
  414.                  (setq char (read-char))
  415.                  (setq num (- char ?0))
  416.                  (cond ((< num 15))    ; hack to map num to choices, avoiding command characters.
  417.                    ((< num 49) (setq num (- num 1)))
  418.                    ((< num 57) (setq num (- num 2)))
  419.                    ((< num 60) (setq num (- num 3)))
  420.                    ((< num 65) (setq num (- num 4)))
  421.                    ((< num 72) (setq num (- num 6)))
  422.                    (t (setq num (- num 7))))
  423.                  (cond ((= char ? ) nil) ; accept word this time only
  424.                    ((= char ?i)    ; accept and insert word into personal dictionary
  425.                     (process-send-string ispell-process (concat "*" word "\n"))    ; no return value
  426.                     (setq ispell:pdict-modified-p '(t))
  427.                     nil)
  428.                    ((= char ?a)    ; accept word, don't insert in dictionary
  429.                     (process-send-string ispell-process (concat "@" word "\n"))    ; no return value
  430.                     (setq ispell:pdict-modified-p (list ispell:pdict-modified-p))
  431.                     nil)
  432.                    ((= char ?r)    ; type in replacement
  433.                     (cons (read-string "Replacement: " word) nil))
  434.                    ((or (= char ??) (= char help-char) (= char ?\C-h))
  435.                     (ispell-choose-help)
  436.                     t)
  437.                    ((= char ?x)
  438.                     (setq ispell:quit t) nil)
  439.                    ((= char ?q)
  440.                     (if (y-or-n-p "Really quit ignoring changes? ")
  441.                     (progn
  442.                       (setq ispell:quit t)
  443.                       (process-send-eof ispell-process) ; terminate process.
  444.                       (setq ispell:pdict-modified-p nil))))
  445.                    ;; Cannot return to initial state after this....
  446.                    ((= char ?l)
  447.                     (let ((new-word (read-string "Lookup string ('*' is wildcard): " word))
  448.                       (new-line 2))
  449.                       (cond (new-word
  450.                          (save-excursion
  451.                            (setq count 0)
  452.                            (set-buffer (get-buffer-create "*Choices*")) (erase-buffer)
  453.                            (setq mode-line-format "--  %b  --")
  454.                            (setq miss (lookup-words new-word))
  455.                            (setq choices miss)
  456.                            (while choices
  457.                          (if (> (+ 7 (current-column) (length (car choices)))
  458.                             (window-width))
  459.                              (progn
  460.                                (insert "\n")
  461.                                (setq new-line (1+ new-line))))
  462.                          (insert "(" (+ count ?0) ") " (car choices) "  ")
  463.                          (setq choices (cdr choices)
  464.                                count (if (memq count '(14 48 56 59 64 71)) ; skip commands
  465.                                  (if (= count 64)
  466.                                      (+ count 3)
  467.                                    (+ count 2))
  468.                                    (1+ count)))))
  469.                          (select-window (previous-window))
  470.                          (if (/= new-line line)
  471.                          (if (> new-line line)
  472.                              (enlarge-window (- new-line line))
  473.                            (shrink-window (- line new-line))))
  474.                          (select-window (next-window)))))
  475.                     t)
  476.                    ((and (>= num 0) (< num count))
  477.                     (nth num miss))
  478.                    ((= char ?\C-l)
  479.                     (redraw-display) t)
  480.                    ((= char ?\C-r)
  481.                     (save-excursion (recursive-edit)) t)
  482.                    ((= char ?\C-z)
  483.                     (suspend-emacs) t)
  484.                    (t (ding) t))))))
  485.       result))
  486.     (if (not ispell:keep-choices-win) (bury-buffer "*Choices*"))))
  487.  
  488. (defun ispell-choose-help ()
  489.   (let ((help-1 "[r]eplace word;  [a]ccept for this session;  [i]nsert into private dictionary;")
  490.     (help-2 "[l]ook a word up in alternate dictionary;  e[x]it;  [q]uit session."))
  491.     (if (and (boundp 'epoch::version)
  492.          (equal epoch::version
  493.             "Epoch 3.1"))
  494.     ;; Enlarging the minibuffer crashes Epoch 3.1
  495.     (with-output-to-temp-buffer "*Ispell Help*"
  496.       (princ help-1)
  497.       (princ "\n")
  498.       (princ help-2))
  499.       (save-window-excursion
  500.     (select-window (minibuffer-window))
  501.     (save-excursion
  502.       (message help-2)
  503.       (enlarge-window 1)
  504.       (message help-1)
  505.       (sit-for 5)
  506.       (erase-buffer)))))
  507.   )
  508.  
  509. (defun lookup-words (word)
  510.   "Look up word in dictionary contained in the
  511.   ispell:alternate-dictionary variable.  A '*' is used for wild cards.
  512.   If no wild cards, LOOK is used if it exists.
  513.   Otherwise the variable ispell:grep-command contains the command used to search
  514.   for the words (usually egrep)."
  515.   ;; We need a new copy of the filter to not overwrite the old copy that may currently be
  516.   ;; utilized for another spelling operation.
  517.   (let ((save-ispell-filter ispell:filter) results)
  518.     (setq ispell:filter nil)            ; flush output filter if currently running
  519.     (if (and ispell:look-p
  520.          (not (string-match "\\*" word)))    ; Only use look for an exact match.
  521.     (let (temp-ispell-process)
  522.       (message "Starting \"look\" process...")
  523.       (sit-for 0)
  524.       (setq temp-ispell-process
  525.         (start-process "look" nil
  526.                    ispell:look-command "-df" word ispell:alternate-dictionary))
  527.       (set-process-filter temp-ispell-process 'ispell-filter)
  528.       (while (progn
  529.            (accept-process-output temp-ispell-process)
  530.            (eq (process-status temp-ispell-process) 'run)))
  531.       (if (zerop (length ispell:filter))    ; assure look worked.
  532.           (progn
  533.         (sit-for 1)            ; Hope this is enough ....
  534.         (accept-process-output temp-ispell-process)
  535.         ;; See callproc.c for this error message in function child_setup.
  536.         ;; This is passed when the program couldn't be found (no "look" here).
  537.         ;; Must recheck using grep if look failed.
  538.         (if (not (string-match "Couldn't exec the program "
  539.                        (car ispell:filter)))
  540.             (setq ispell:filter nil)    ; look failed, and there was no error.  No match!
  541.           (message "Look failed, starting \"egrep\" process...")
  542.           (sit-for 0)
  543.           (setq ispell:look-p nil    ; No look, disable it from now on.
  544.             ispell:filter nil
  545.             ispell:filter-continue nil) ; Above message DOESN'T send linefeed!
  546.           (setq temp-ispell-process    ; Search for word using ispell:grep-command
  547.             (start-process "egrep" nil ispell:grep-command
  548.                        "-i" (concat "^" word "$") ispell:alternate-dictionary))
  549.           (set-process-filter temp-ispell-process 'ispell-filter)
  550.           (while (progn
  551.                (accept-process-output temp-ispell-process)
  552.                (eq (process-status temp-ispell-process) 'run)))))))
  553.       (message "Starting \"egrep\" process...")
  554.       (sit-for 0)
  555.       (let ((start 0)                ; Format correctly for egrep search.
  556.         new-word end)
  557.     (while (progn
  558.          (if (setq end (string-match "\\*" word start))
  559.              (progn
  560.                (setq new-word (concat new-word (substring word start end) ".*"))
  561.                (setq start (1+ end)))
  562.            (setq new-word (concat new-word (substring word start)))
  563.            nil)))
  564.     (setq word (concat "^" new-word "$")))
  565.       (let ((temp-ispell-process (start-process "egrep" nil ispell:grep-command
  566.                         "-i" word ispell:alternate-dictionary)))
  567.     (set-process-filter temp-ispell-process 'ispell-filter)
  568.     (while (progn
  569.          (accept-process-output temp-ispell-process)
  570.          (eq (process-status temp-ispell-process) 'run)))))
  571.     (setq results ispell:filter ispell:filter save-ispell-filter) ; Restore ispell:filter value.
  572.     (nreverse results)))            ; return filtered output.
  573.  
  574.  
  575. ;;; "ispell:filter" is a list of output lines from the generating function.
  576. ;;;   Each full line (ending with \n) is a separate item on the list.
  577. ;;; "output" can contain multiple lines, part of a line, or both.
  578. ;;; "start" and "end" are used to keep bounds on lines when "output" contains
  579. ;;;   multiple lines.
  580. ;;; "ispell:filter-continue" is true when we have received only part of
  581. ;;;   a line as output from a generating function ("output" did not end with a \n).
  582. ;;; NOTE THAT THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH A \n!
  583. ;;;   This is the case when a process dies or fails -- see lookup-words.
  584. ;;;   the default behavior in this case is to treat the next input as fresh input
  585. (defun ispell-filter (process output)
  586.   "Output filter function for ispell, grep, and look."
  587.   (let ((start 0)
  588.     (continue t)
  589.     end)
  590.     (while continue
  591.       (setq end (string-match "\n" output start)) ; get text up to the newline.
  592.       ;; If we get out of sync and ispell:filter-continue is asserted when we are not
  593.       ;; continuing, treat the next item as a separate list.
  594.       ;; When ispell:filter-continue is asserted, ispell:filter *should* always be a list!
  595.       (if (and ispell:filter-continue ispell:filter (listp ispell:filter)) ; Continue with same line (item)?
  596.       (setcar ispell:filter (concat (car ispell:filter) ;Add it to the prev item
  597.                     (substring output start end)))
  598.     (setq ispell:filter (cons (substring output start end) ; This is a new line and item.
  599.                   ispell:filter)))
  600.       (if (null end)                ; We've completed reading the output.
  601.       (setq ispell:filter-continue t continue nil) ; We didn't finish with the line.
  602.     (setq ispell:filter-continue nil end (1+ end)) ; Get new item next time.
  603.     (if (= end (length output))        ; No more lines in output
  604.         (setq continue nil)            ;  so we can exit the filter.
  605.       (setq start end))))))            ; Move start to next line of input.
  606.  
  607.  
  608. (defun highlight-spelling-error (start end &optional highlight)
  609.   "Highlight a word by toggling inverse-video.
  610.   highlights word from START to END.
  611.   When the optional third arg HIGHLIGHT is set, the word is drawn in inverse
  612.   video, otherwise the word is drawn in normal video mode."
  613.   (if (string-match "^19\\." emacs-version)
  614.       (highlight-spelling-error-v19 start end highlight)
  615.     ;; else 
  616.   (let ((modified (buffer-modified-p))        ; leave buffer unmodified if highlight modifies it.
  617.     (text (buffer-substring start end))    ; Save highlight region
  618.     (inhibit-quit t)            ; don't process interrupt until this function exits
  619.     (buffer-undo-list nil))            ; We're not doing anything permanent here, so dont'
  620.                             ;  clutter the undo-list with it.
  621.     (delete-region start end)
  622.     (insert-char ?  (- end start))        ; white out region to mimimize amount of redisplay
  623.     (sit-for 0)                    ; update display
  624.     (if highlight (setq inverse-video (not inverse-video))) ; toggle inverse-video
  625.     (delete-region start end)            ; delete whitespace
  626.     (insert text)                ; insert text in inverse video.
  627.     (sit-for 0)                    ; update display showing inverse video.
  628.     (if highlight (setq inverse-video (not inverse-video))) ; toggle inverse-video
  629.     (set-buffer-modified-p modified))))        ; don't modify if flag not set.
  630.  
  631. (defun highlight-spelling-error-v19 (start end &optional highlight)
  632.   (if highlight
  633.       (setq ispell-saved-selection (cons selection-begin selection-end)
  634.         selection-begin (set-marker (make-marker) start)
  635.         selection-end (set-marker (make-marker) end))
  636.     (setq selection-begin (car ispell-saved-selection)
  637.       selection-end (cdr ispell-saved-selection)
  638.       ispell-saved-selection nil))
  639.   (sit-for 0))
  640.  
  641.  
  642. (defun overlay-window (height)
  643.   "Create a (usually small) window with HEIGHT lines and avoid
  644. recentering."
  645.   (save-excursion
  646.     (let ((oldot (save-excursion (beginning-of-line) (point)))
  647.       (top (save-excursion (move-to-window-line height) (point)))
  648.       newin)
  649.       (if (< oldot top) (setq top oldot))
  650.       (setq newin (split-window-vertically height))
  651.       (set-window-start newin top))))
  652.  
  653.  
  654. (defun ispell-parse-output (output)
  655.   "Parse the OUTPUT string of 'ispell' and return:
  656.  1) T for an exact match.
  657.  2) A string containing the root word for a match via suffix removal.
  658.  3) A list of possible correct spellings of the format:
  659.     '(\"original-word\" offset miss-list guess-list)
  660.     original-word is a string of the possibly misspelled word.
  661.     offset is an integer of the line offset of the word.
  662.     miss-list and guess-list are possibly null list of guesses and misses."
  663.   (cond
  664.    ((string= output "") t)            ; for startup with pipes...
  665.    ((string= output "*") t)            ; exact match
  666.    ((string= (substring output 0 1) "+")    ; found cuz of rootword
  667.     (substring output 2))            ; return root word
  668.    (t                        ; need to process &,?, and #'s
  669.     (let ((type (substring output 0 1))        ; &, ?, or #
  670.       (original-word (substring output 2 (string-match " " output 2)))
  671.       (cur-count 0)                ; contains current number of misses + guesses
  672.       count miss-list guess-list)
  673.       (setq output (substring output (match-end 0))) ; skip over original misspelling
  674.       (if (string= type "#")
  675.       (setq count 0)            ; no misses for type #
  676.     (setq count (string-to-int output))    ; get number of misses.
  677.     (setq output (substring output (1+ (string-match " " output 1)))))
  678.       (setq offset (string-to-int output))
  679.       (if (string= type "#")            ; No miss or guess list.
  680.       (setq output nil)
  681.     (setq output (substring output (1+ (string-match " " output 1)))))
  682.       (while output
  683.     (let ((end (string-match ",\\|\\($\\)" output))) ; end of next miss/guess.
  684.       (setq cur-count (1+ cur-count))
  685.       (if (> cur-count count)
  686.           (setq guess-list (cons (substring output 0 end) guess-list))
  687.         (setq miss-list (cons (substring output 0 end) miss-list)))
  688.       (if (match-end 1)            ; True only when at end of line.
  689.           (setq output nil)            ; no more misses or guesses
  690.         (setq output (substring output (+ end 2))))))
  691.       (list original-word offset miss-list guess-list)))))
  692.  
  693.  
  694. (defun ispell-init-process ()
  695.   "Check status of 'ispell' process and start if necessary."
  696.   (if (and ispell-process
  697.        (eq (process-status ispell-process) 'run))
  698.       (setq ispell:filter nil ispell:filter-continue nil)
  699.     (message "Starting new ispell process...")
  700.     (sit-for 0)
  701.     (setq ispell-process
  702.       (apply 'start-process
  703.          "ispell" nil ispell:program-name
  704.          "-a";; accept single input lines
  705.          "-m";; make root/affix combinations not in the dict
  706.          (let ((args (ispell:get-ispell-args)))
  707.            (if ispell:dictionary ; maybe use other dict
  708.                (setq args
  709.                  (append (list "-d" ispell:dictionary)
  710.                      args)))
  711.            args))
  712.       ispell:filter nil
  713.       ispell:filter-continue nil)
  714.     (set-process-filter ispell-process 'ispell-filter)
  715.     (accept-process-output ispell-process)    ; Get version ID line
  716.     (setq ispell:filter nil)            ; Discard version ID line
  717.     (process-send-string ispell-process "!\n")    ; Put into terse mode -- save processing & parsing time!
  718.     (process-kill-without-query ispell-process)))
  719.  
  720. (defun ispell-kill-ispell (&optional no-error)
  721.   "Kill current ispell process (so that you may start a fresh one)."
  722.   ;; With NO-ERROR, just return non-nil if there was no ispell
  723.   ;; running.
  724.   (interactive)
  725.   (if (not (and ispell-process
  726.         (eq (process-status ispell-process) 'run)))
  727.       (or no-error
  728.       (error "There is no ispell process running!"))
  729.     (kill-process ispell-process)
  730.     (message "Killed ispell process.")
  731.     nil))
  732.  
  733. (defun ispell-change-dictionary (dict)
  734.   "Change ispell:dictionary (q.v.) and kill old ispell process.
  735. A new one will be started as soon as necessary.
  736.  
  737. By just answering RET you can find out what the current dictionary is."
  738.   (interactive
  739.    (list (completing-read "Use new ispell dictionary (type SPC to complete): "
  740.               ispell:dictionary-alist
  741.               nil t)))
  742.   ;; Like info.el, we also rely on completing-read's bug of returning
  743.   ;; "" even if this is not in the table:
  744.   (if (equal dict "")
  745.       (setq dict nil))
  746.   (if (equal dict ispell:dictionary)
  747.       (message "(No change, using %s dictionary)"
  748.            (if dict dict "default"))
  749.     (setq ispell:dictionary dict)
  750.     (ispell-kill-ispell t)
  751.     (message "(Next ispell command will use %s dictionary)"
  752.          (if dict dict "default")))
  753.   )
  754.  
  755. ;;; Requires ispell version 2.1.02 or later.
  756. ;;; Ispell processes the file and no UNIX filters are used.
  757. ;;; This allows tex and nroff files to be processed well (ispell knows about them).
  758. ;;; Spelling of comments are checked when ispell:check-comments is non-nil.
  759. (defun ispell-region (reg-start reg-end)
  760.   "Interactively check a region for spelling errors."
  761.   (interactive "*r")
  762.   (ispell-init-process)
  763.   (if (memq major-mode '(plain-TeX-mode plain-tex-mode TeX-mode tex-mode LaTeX-mode latex-mode))
  764.       (process-send-string ispell-process "+\n")    ; set ispell mode to tex
  765.     (process-send-string ispell-process "-\n"))        ; set ispell mode to normal (nroff)
  766.   (unwind-protect
  767.   (save-excursion
  768.     (message "Spelling %s..."
  769.          (if (and (= reg-start (point-min)) (= reg-end (point-max)))
  770.          (buffer-name) "region"))
  771.     (sit-for 0)
  772.     ;; must be top level now, not inside ispell-choose for keeping window around.
  773.     (save-window-excursion
  774.     (if ispell:keep-choices-win
  775.     (let ((window-min-height 2))
  776.       (setq ispell:keep-choices-win 2)    ; This now keeps the window size.
  777.       (overlay-window 2)
  778.       (switch-to-buffer (get-buffer-create "*Choices*"))
  779.       (setq mode-line-format "--  %b  --")
  780.       (erase-buffer)
  781.       (select-window (next-window))))
  782.     (goto-char reg-start)
  783.     (while (and (not ispell:quit) (< (point) reg-end))
  784.       (let ((start (point))
  785.         (offset-change 0)
  786.         (end (save-excursion (end-of-line) (min (point) reg-end)))
  787.         (ispell-casechars (ispell:get-casechars))
  788.         string)
  789.     (cond ((eolp)                ; if at end of line, just go to next.
  790.            (forward-char 1))
  791.           ((and (null ispell:check-comments)
  792.             comment-start        ; skip comments that start on the line.
  793.             (search-forward comment-start end t)) ; a comment is on this line.
  794.            (if (= (- (point) start) (length comment-start)) ; comments starts line.
  795.            (if (string= "" comment-end) ; skip to next line over comment
  796.                (beginning-of-line 2)
  797.              (search-forward comment-end reg-end 'limit)) ; Skip to end of comment
  798.          ;; Comment starts later on line.
  799.          ;; Only send string if it contains "casechars" before comment.
  800.          (let ((limit (- (point) (length comment-start)))) 
  801.            (goto-char start)
  802.            (if (re-search-forward ispell-casechars limit t)
  803.              (setq string (concat "^" (buffer-substring start limit) "\n")))
  804.            (goto-char limit))))
  805.           ((and (null ispell:check-tib)
  806.             (re-search-forward ispell:tib-ref-beginning end t))
  807.            ;; Skip to end of tib ref, not necessarily on this line
  808.            (or (re-search-forward ispell:tib-ref-end reg-end 'move)
  809.            (error "No end for tib reference %s"
  810.               (buffer-substring (point) end)))
  811.            (let (limit)
  812.          (goto-char (match-end 0)) ; end of tib ref
  813.          (skip-chars-forward " \t\f\n" reg-end)
  814.          ;; maybe we skipped several lines, need new `start' and `end'
  815.          (setq start (point)
  816.                end (save-excursion (end-of-line)
  817.                        (min (point) reg-end))
  818.                limit (if (re-search-forward ispell:tib-ref-beginning
  819.                             end 'move)
  820.                  (match-beginning 0)
  821.                    end))
  822.          ;; Only send string if it contains "casechars"
  823.          (goto-char start)
  824.          (if (re-search-forward ispell-casechars limit t)
  825.              (progn
  826.                (setq string (concat "^"
  827.                         (buffer-substring start
  828.                                   limit)
  829.                         "\n"))
  830.                (goto-char limit)))))
  831.           ((looking-at "[---#@*+!%~^]")    ; looking at the special ispell characters..
  832.            (forward-char 1))        ; skip over it.
  833.           ((re-search-forward ispell-casechars end t) ; text exists...
  834.            (setq string (concat "^" (buffer-substring start end) "\n"))
  835.            (goto-char end))
  836.           (t (beginning-of-line 2)))    ; empty line, skip it.
  837.     (setq end (point))            ; use "end" to track end of region to check.
  838.     (if string                ; there is something to spell!
  839.         (let (poss)
  840.           ;; send string to spell process and get input.
  841.           (process-send-string ispell-process string)
  842.           (while (progn
  843.                (accept-process-output ispell-process)
  844.                (not (string= "" (car ispell:filter)))))    ;Last item of output contains a blank line.
  845.           ;; parse all inputs from the stream one word at a time.
  846.           (setq ispell:filter (nreverse (cdr ispell:filter))) ; remove blank item.
  847.           (while (and (not ispell:quit) ispell:filter)
  848.         (setq poss (ispell-parse-output (car ispell:filter)))
  849.         (if (listp poss)        ; spelling error occurred.
  850.             (let* ((word-start (+ start offset-change (car (cdr poss))))
  851.                (word-end (+ word-start (length (car poss))))
  852.                replace)
  853.               ;; debug debug debug
  854.               (if ispell:keep-choices-win (sit-for 0))
  855.               (goto-char word-start)
  856.               (if (/= word-end (progn
  857.                      (re-search-forward (car poss) word-end t)
  858.                      (point)))
  859.               ;; This usually occurs due to pipe problems with the filter.
  860.               (error "***ispell misalignment: word \"%s\" point %d; please retry."
  861.                  (car poss) word-start))
  862.               (unwind-protect
  863.               (progn
  864.                 (if ispell:highlight-p
  865.                 (highlight-spelling-error word-start word-end t) ; highlight word
  866.                   (sit-for 0))    ; otherwise, update screen.
  867.                 (setq replace (ispell-choose (car (cdr (cdr poss)))
  868.                              (car (cdr (cdr (cdr poss))))
  869.                              (car poss))))
  870.             ;; protected
  871.             (if ispell:highlight-p
  872.                 (highlight-spelling-error word-start word-end))) ; un-highlight
  873.               (goto-char word-start)
  874.               (if replace
  875.               (if (listp replace)    ; re-check all list replacements; otherwise exit.
  876.                   (progn
  877.                 ;; quit parsing this line, redo rest when re-checking new word.
  878.                 (setq ispell:filter nil)
  879.                 ;; adjust regions
  880.                 (let ((change (- (length (car replace)) (length (car poss)))))
  881.                   (setq reg-end (+ reg-end change))
  882.                   (setq offset-change (+ offset-change change)))
  883.                 (delete-region word-start word-end)
  884.                 (insert (car replace))
  885.                 (backward-char (length (car replace)))
  886.                 (setq end (point))) ; reposition within region to recheck spelling.
  887.                 (delete-region word-start word-end)
  888.                 (insert replace)
  889.                 (let ((change (- (length replace) (length (car poss)))))
  890.                   (setq reg-end (+ reg-end change)
  891.                     offset-change (+ offset-change change)
  892.                     end (+ end change))))
  893.             ;; This prevents us from pointing out the word that was just accepted
  894.             ;; (via 'i' or 'a') if it follows on the same line. (The one drawback of
  895.             ;; processing an entire line.)  Redo check following the accepted word.
  896.             (cond ((and (not (null ispell:pdict-modified-p)) (listp ispell:pdict-modified-p))
  897.                    ;; We have accepted or inserted a word.  Re-check line.
  898.                    (setq ispell:pdict-modified-p (car ispell:pdict-modified-p)) ; fix update flag
  899.                    (setq ispell:filter nil) ; don't continue check.
  900.                    (setq end word-end)))) ; reposition to check line following accepted word.
  901.               (message "continuing spelling check...")
  902.               (sit-for 0)))
  903.         (setq ispell:filter (cdr ispell:filter))))) ; finished with this check.
  904.     (goto-char end)))))
  905.   (progn
  906.     (if (get-buffer "*Choices*")
  907.     (kill-buffer "*Choices*"))
  908.     (ispell-pdict-save)
  909.     (if ispell:quit (setq ispell:quit nil))
  910.     (message "Spell done."))))
  911.  
  912.  
  913. (defun ispell-buffer () 
  914.   "Check the current buffer for spelling errors interactively."
  915.   (interactive)
  916.   (ispell-region (point-min) (point-max)))
  917.  
  918. ;; Interactive word completion.
  919. ;; Some code and many ideas tweaked from Peterson's spell-dict.el.
  920. ;; Ashwin Ram <Ram@yale>, 8/14/87.
  921.  
  922. ;; Ported from ispell 2 to ispell 3 by Sebastian Kremer <sk@thp.uni-koeln.de>
  923. ;; 7-Aug-1991 13:44
  924.  
  925. (defvar ispell-words-file "/usr/dict/words"
  926.    "*File used for ispell-complete-word command.  On 4.3bsd systems, try
  927. using \"/usr/dict/web2\" for a larger selection.  Apollo users may want to
  928. try \"/sys/dict\".")
  929.  
  930. (defun ispell-complete-word ()
  931.    "Look up word before point in dictionary (see the variable
  932. ispell-words-file) and try to complete it.  If in the middle of a word,
  933. replace the entire word."
  934.    (interactive)
  935.    (let* ((current-word (buffer-substring (save-excursion
  936.                         (forward-word -1) (point))
  937.                                           (point)))
  938.           (in-word (looking-at "\\w"))
  939.       (ispell:filter-continue t)
  940.           (possibilities
  941.          (or (string= current-word "") ; Will give you every word
  942.          (setq ispell:filter (lookup-words current-word))
  943.          (if (not (null ispell:filter))
  944.              (ispell-parse-output (car ispell:filter))
  945.            '())))
  946.  
  947.       (ispell:keep-choices-win nil)
  948.       (replacement (ispell-choose possibilities nil current-word)))
  949.      (cond (replacement
  950.         (if in-word (kill-word 1));; Replace the whole word.
  951.         (search-backward current-word)
  952.         (replace-match replacement)))));; To preserve capitalization etc.
  953.